perm filename SCAN.SAI[DIA,HPM] blob
sn#501150 filedate 1980-03-07 generic text, type T, neo UTF8
BEGIN "SCAN"
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
INTEGER IPIC_HI,IPIC_LO,PW,PH,PB,PIC_SIZ; STRING IPIC_NAME,INST;
INTEGER ARRAY PIC_DIM[0:10]; BOOLEAN ERR;
DO
BEGIN "get file names"
OUTSTR("FILES (eg OBS(3:15)):"); INST←INCHWL;
BEGIN "decode file specs"
INTEGER I,J;
ERR←FALSE;
IPIC_NAME←"";
WHILE INST≠"(" AND LENGTH(INST)>0 DO IPIC_NAME←IPIC_NAME&LOP(INST);
IF INST="(" THEN
BEGIN
IPIC_LO←INTSCAN(INST,J); IF J≠":" THEN ERR←TRUE;
IPIC_HI←INTSCAN(INST,J); IF J≠")" THEN ERR←TRUE;
J←LOP(INST); IPIC_NAME←IPIC_NAME&INST;
PRSFIL(""); PRSFIL(IPIC_NAME);
END;
END "decode file specs";
END
UNTIL ¬ERR ∧ (PIC_SIZ←GETPFD("."&CVS(IPIC_LO),PIC_DIM[0]))>0;
BEGIN
INTEGER I,PIC_ID;
INTEGER ARRAY PIC[0:PIC_SIZ];
INTEGER ARRAY DDB[2:4,0:DDSIZ];
DDINIT; FOR I←2 STEP 1 UNTIL 4 DO DDSTOR(DDB[I,0]);
MAPMON(1,54);
FOR PIC_ID←IPIC_LO STEP 1 UNTIL IPIC_HI DO
BEGIN
INTEGER CNT,CM18,I;
CNT←PIC_ID - IPIC_LO; CM18←CNT MOD 18;
CNT←(CNT - CM18) + (IF CM18<9 THEN CM18 ELSE 26-CM18);
CNT←CNT+IPIC_LO;
SETFORMAT(0,0);
PRSFIL(""); PRSFIL(IPIC_NAME); GETPFL("."&CVS(CNT),PIC[0]);
VIDFGX(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF,0,0);
IF (CNT MOD 2)=0 THEN
BEGIN
DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL 3 DO IF SYNMAP(I)>0
THEN DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
END
ELSE
BEGIN
IF SYNMAP(4)>0 THEN DPYUP(SYNMAP(4));
FOR I←1 STEP 1 UNTIL 3 DO IF SYNMAP(I+4)>0
THEN DPYUP(SYNMAP(I+4),LOCATION(DDB[I+1,0]));
END;
BEGIN "MAPSET"
REAL PROCEDURE F(REAL X);
BEGIN
INTEGER IX,NX;
IF (CNT MOD 2)=1 THEN
BEGIN
IX←X * '400;
IX←IX LAND '17;
END
ELSE
IX←X * '20;
RETURN(IX/'20);
END;
MAPSET(F,FALSE);
END "MAPSET"
END;
END;
END "SCAN";